functor Machinize (S : MACHINIZE_STRUCTS) : MACHINIZE =
struct
  open S
  
  structure Cfg = Cfg
  structure Machine = Machine
  structure T = Cfg.Types
  
  val error = ErrorMsg.error
  
  val tag = false
  fun debugPrint s =
      if tag
      then print s
      else ()
      
  
  local open Cfg
  in structure Id = Id
     structure Intl = Intl
     structure CB = Binop
     structure CO = Operand
     structure CK = Block
     structure CS = Structs
     structure CJ = Transfer
     structure CM = Stm
     structure CF = Function
     structure CP = Program
  end
  
  local open Machine
  in structure B = Binop
     structure R = Register
     structure L = Location
     structure O = Operand
     structure K = Block
     structure S = Structs
     structure J = Transfer
     structure M = Stm
     structure F = Function
     structure P = Program
  end
  
  fun printList (n, l, info) =
      let val _ = debugPrint (String.concat ["\nthe ", info, " of ", Id.toString n, " is:\n"])
          val _ = List.app debugPrint (List.map Id.toString l)
      in  ()
      end
  
  (*    
  structure VarPool :>
  sig
    val add : {id : Id.t, ty : T.t} -> unit
    val getAll : unit -> {id : Id.t, ty : T.t} list
  end =
  struct
    val all : {id : Id.t, ty : T.t} list ref = ref []
      
    fun add {id, ty} = all := {id = id, ty = ty} :: (!all)
    fun init () = all := []
    fun getAll () =
        let val x = !all
            val _ = init ()
        in  x
        end
  end
  
  structure StmPool :>
  sig      
    val emit : M.t -> unit
    val emits : M.t list -> unit
    val init : unit -> unit
    val get : unit -> M.t list
  end =
  struct
    val all : M.t list ref = ref []
    
    val init = fn () => all := []    
    fun emit s = all := (!all) @ [s]
    fun emits ss = List.app emit ss
    fun get () = !all
  end
  
  structure BlockPool :
  sig
    val add : M.t -> unit
    val flush : Id.t list -> unit
    val getAll : unit -> K.t list
    val initAll : unit -> unit
  end =
  struct
    val all : K.t list ref = ref []
    val one : M.t list ref = ref []
        
    fun add s = one := (!one) @ [s]
        
    fun flush (succs) =
        let val b = K.T {name = Id.new (),
                         prop = true,
                         stms = !one,
                         transfer = J.bogus (),
                         successors = succs}
        in  all := (!all) @ [b]
        ; one := []
        end
    
    fun initAll () = (all := []; one := [])       
    fun getAll () = !all before initAll ()
  end
  *)
  fun transBop bop = 
      let val _ = ()
      in  case bop
           of CB.Plus => B.Plus
	    | CB.Minus => B.Minus
	    | CB.Times => B.Times
	    | CB.Divide => B.Divide
	    | CB.Modus => B.Modus
	    | CB.And => B.And
	    | CB.Or => B.Or
	    | CB.Not => B.Not
	    | CB.Eq => B.Eq
	    | CB.Ne => B.Ne
	    | CB.Gt => B.Gt
	    | CB.Ge => B.Ge
	    | CB.Lt => B.Lt
	    | CB.Le => B.Le
      end
  
  fun transOperand v = 
      let val _ = ()
      in  case v
           of CO.IntNum i => O.IntNum i
            | CO.True => O.True
            | CO.False => O.False
            | CO.Null => O.Null
            | CO.Mem {id, ty} =>
              O.Mem {id = id, ty = ty}
            | CO.Var {id, ty} =>
              O.Var {id = id, ty = ty}
            | CO.OpVoid => O.OpVoid
      end 
      
  fun transStm s = 
      case s
       of CM.Assign {line, dest, src, ty} =>
          let val newDest = transOperand dest
              val newSrc = transOperand src
              val new = M.Assign {line = line, dest = newDest, src = newSrc, ty = ty}
          in  [new]
          end
        | CM.AssignExp {line, dest, bop, src, ty} =>
          let val newDest = transOperand dest
              val newSrc = List.map transOperand src
              val newBop = transBop bop
              val new = M.AssignExp {line = line, 
                                     dest = newDest, 
                                     bop = newBop, 
                                     src = newSrc, 
                                     ty = ty}
          in  [new]
          end
        | CM.AssignCall {line, dest, fid, src} =>
          let val newDest = transOperand dest
              val newReg = O.Reg {reg = R.eax, ty = T.Voidt} (* ty not yet *)
              val newSrc = List.map transOperand src
              val new1 = M.Call {line = line, 
                                 fid = fid, 
                                 src = newSrc, 
                                 ty = T.Voidt} (* ty not yet *)
              val new2 = M.Assign {line = line, 
                                   dest = newDest, 
                                   src = newReg, 
                                   ty = T.Voidt} (* ty not yet *)
          in  [new1, new2]
          end
        | CM.Call {line , fid , src} =>
          let val newSrc = List.map transOperand src
              val new = M.Call {line = line, fid = fid, src = newSrc, ty = T.Voidt} (* ty not yet *) 
          in  [new]
          end
        | CM.Alloc {line, ty, dest} =>
          let val newDest = transOperand dest
              val newReg = O.Reg {reg = R.eax, ty = T.Voidt} (* ty not yet *)
              val new1 = M.Alloc {line = line, fid = Id.fromString "malloc", ty = ty}
              val new2 = M.Assign {line = line,
                                   dest = newDest,
                                   src = newReg,
                                   ty = T.Pointt ty}
          in  [new1, new2]
          end
        | CM.Free {line, ty, src} =>
          let val newSrc = transOperand src
              val new = M.Call {line = line, fid = Id.fromString "free", ty = ty, src = [newSrc]}
          in  [new]
          end
        | CM.Label _ => raise Fail "compiler bug: no such cases: Label"
        | CM.Exp _ => raise Fail "compiler bug: no such cases : Exp"
        | CM.Phi _ => raise Fail "to do: should be eleminated before machinize: Phi"
        | CM.SJump _ => raise Fail "compiler bug: no such cases : SJump"
        | CM.SIf _ => raise Fail "compiler bug: no such cases : SIf"
  
  fun transStms ss = List.concat (List.map transStm ss)
  
  fun transTransfer j =
      case j
       of CJ.Jump {line, label} => 
          J.Jump {line = line, label = label}
        | CJ.If {line, value, truee, falsee} =>
          let val newvalue = transOperand value
              val new = J.If {line = line, value = newvalue, truee = truee, falsee = falsee}
          in  new
          end
        | CJ.Return {line, value} =>
          let val newvalue = transOperand value
              val new = J.Return {line = line, value = newvalue}
          in  new
          end
  
  fun transBlock b = 
      case b
       of CK.T {name,
                prop,
                stms,
                transfer,
                successors} =>
          let val newStms = transStms stms
              val newTransfer = transTransfer transfer
              val new = K.T {name = name,
                             prop = prop,
                             stms = newStms,
                             transfer = newTransfer,
                             successors = successors}
          in  new
          end

  fun transBlocks blocks = List.map transBlock blocks    
  
  fun transArgs args =
      let val argSize = 4
          val initSize = 8
          val argList = args
          fun doit (args, index) =
              case args
               of [] => []
                | {id, ty} :: xs =>
                  {id = id, loc = L.InStack (Intl.fromInt index), ty = ty} ::
                  doit (xs, index + argSize)
          val result = doit (argList, initSize) 
      in  result
      end
          
  fun transFunc f =
      case f
       of CF.T {name,
                exit,
                rettype,
                args,
                locals,
                blocks,
                pre,
                post} =>
          let val newArgs = transArgs args
              val newBlocks = transBlocks blocks
              val newLocals = List.map (fn {id, ty} => {id = id, ty = ty, loc = L.bogus ()}) locals
              val new = F.T {name = name,
                             exit = exit,
                             rettype = rettype,
                             args = newArgs,
                             locals = newLocals,
                             stackSize = Intl.bogus (),
                             blocks = newBlocks,
                             pre = O.True,
                             post = O.True}
          in  new
          end
      
  fun transFuncs funcs = List.map transFunc funcs
  
  fun transProg p =
      case p
       of CP.T {structs,
                gvars,
                funcs} =>
          P.T {structs = [],
               gvars = gvars,
               funcs = transFuncs funcs}
  
  fun trans p =
      let val _ = debugPrint "to machine translation starting\n"
          val new = transProg p
          val _ = debugPrint "to machine translation finished\n"
      in  new
      end
end
